home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / ISSUE19 / ISAPI / TEST1.DPR < prev    next >
Encoding:
Text File  |  1997-01-16  |  4.0 KB  |  136 lines
  1. library Test1;
  2.  
  3. uses
  4.   SysUtils, Classes, Windows, Isapi;
  5.  
  6. const
  7.   HSE_IO_SYNC      = 1;
  8.   HSE_IO_ASYNC     = 2;
  9.  
  10. function GetExtensionVersion( Ver: THSE_VERSION_INFO ): BOOL; stdcall;
  11. begin
  12.   Ver.dwExtensionVersion := MakeLong(HSE_VERSION_MINOR, HSE_VERSION_MAJOR);
  13.   StrLCopy(Ver.lpszExtensionDesc,
  14.            'Internet Server Application, Example #1',
  15.            HSE_MAX_EXT_DLL_NAME_LEN);
  16.   Result := True;
  17. end;
  18.  
  19. function HttpExtensionProc( var ECB: TEXTENSION_CONTROL_BLOCK ): DWORD; stdcall;
  20.  
  21.   procedure UnpackURLString( S: PChar; List: TStringList );
  22.   { Parses and decodes a URL-encoded string.  Copies variable values into List. }
  23.   var
  24.     LabelStr, ValueStr: ShortString;
  25.   begin
  26.     LabelStr := '';
  27.     ValueStr := '';
  28.     while S^ <> #0 do
  29.     begin
  30.       case S^ of
  31.         '+' : ValueStr := ValueStr + ' ';
  32.         '%' : begin
  33.                 ValueStr := ValueStr + Chr(StrToInt('$' + (S + 1)^ + (S + 2)^));
  34.                 Inc(S, 2);
  35.               end;
  36.         '=' : if LabelStr = '' then begin
  37.                 LabelStr := ValueStr;
  38.                 ValueStr := '';
  39.               end;
  40.         '&' : begin
  41.                 List.Values[LabelStr] := ValueStr;
  42.                 ValueStr := '';
  43.                 LabelStr := '';
  44.               end;
  45.         else ValueStr := ValueStr + S^;
  46.       end;
  47.       Inc(S);
  48.     end;
  49.  
  50.     if ValueStr <> '' then
  51.       List.Values[LabelStr] := ValueStr;
  52.   end;
  53.  
  54.   function ISAWriteLn(Msg: string): Boolean;
  55.   { Encapsulate the WriteClient callback into something more manageable. }
  56.   var
  57.     NBytes: DWORD;
  58.     Buffer: PChar;
  59.   begin
  60.     Buffer := StrAlloc(Length(Msg) + 3);
  61.     try
  62.       StrPCopy(Buffer, Msg);
  63.       StrCat(Buffer, #13#10);
  64.       nBytes := StrLen(Buffer);
  65.       Result := ECB.WriteClient(ECB.ConnID, Buffer, NBytes, HSE_IO_SYNC);
  66.     finally
  67.       StrDispose(Buffer);
  68.     end;
  69.   end;
  70.  
  71. var
  72.   FormFields: TStringList;
  73.   I: Integer;
  74.   PostData: PChar;
  75. begin
  76.   FormFields := TStringList.Create;
  77.   try
  78.     with ECB do
  79.     begin
  80.       if StrPas(lpszMethod) = 'GET' then
  81.         UnpackURLString(lpszQueryString, FormFields)
  82.       else begin
  83.         if Assigned(ECB.lpbData) then begin
  84.           PostData := StrAlloc(cbAvailable + 1);
  85.           StrMove(PostData, ECB.lpbData, cbAvailable);
  86.           UnpackURLString(PostData, FormFields);
  87.         end;
  88.       end;
  89.  
  90.       ISAWriteLn('<HTML><HEAD>');
  91.       ISAWriteLn('<TITLE>ISAPI Response Page</TITLE>');
  92.       ISAWriteLn('</HEAD><BODY>');
  93.  
  94.       ISAWriteLn('<PRE>Environment Control Block');
  95.       ISAWriteLn('<BR>');
  96.       ISAWriteLn('cbSize             = ' + IntToStr(cbSize));
  97.       ISAWriteLn('dwVersion          = ' + IntToStr(dwVersion shr 16) + '.' +
  98.                                            IntToStr(dwVersion and $FFFF));
  99.       ISAWriteLn('ConnID             = ' + IntToStr(ConnID));
  100.       ISAWriteLn('dwHttpStatusCode   = ' + IntToStr(dwHttpStatusCode));
  101.       ISAWriteLn('lpszLogData        = ' + lpszLogData);
  102.       ISAWriteLn('lpszMethod         = ' + StrPas(lpszMethod));
  103.       ISAWriteLn('lpszQueryString    = ' + StrPas(lpszQueryString));
  104.       ISAWriteLn('lpszPathInfo       = ' + StrPas(lpszPathInfo));
  105.       ISAWriteLn('lpszPathTranslated = ' + StrPas(lpszPathTranslated));
  106.       ISAWriteLn('cbTotalBytes       = ' + IntToStr(cbTotalBytes));
  107.       ISAWriteLn('cbAvailable        = ' + IntToStr(cbAvailable));
  108.       if not Assigned(lpbData) then
  109.         ISAWriteLn('lpbData            = nil')
  110.       else
  111.         ISAWriteLn('lpbData            = ' + StrPas(PostData));
  112.  
  113.       ISAWriteLn('lpszContentType    = ' + StrPas(lpszContentType));
  114.  
  115.       ISAWriteLn('');
  116.       ISAWriteLn('Form Fields:');
  117.       for I := 0 to FormFields.Count - 1 do
  118.         ISAWriteLn(IntToStr(I) + ' ' + FormFields[I]);
  119.  
  120.       ISAWriteln('</PRE>');
  121.       ISAWriteLn('</BODY></HTML>');
  122.     end;
  123.   finally
  124.     FormFields.Free;
  125.     StrDispose(PostData);
  126.     Result := HSE_STATUS_SUCCESS;
  127.   end;
  128. end;
  129.  
  130. exports
  131.   GetExtensionVersion,
  132.   HttpExtensionProc;
  133.  
  134. begin
  135. end.
  136.